home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 41 / 041.d81 / snag source (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  21KB  |  779 lines
  1. 1000 sys700:.opt oo
  2. 1010 *=$c000
  3. 1020 ;
  4. 1030 ;********************************
  5. 1040 ;*                              *
  6. 1050 ;*           snag 1.0           *
  7. 1060 ;*                              *
  8. 1070 ;* copyright 1987  by nick peck *
  9. 1080 ;*                              *
  10. 1090 ;********************************
  11. 1100 ;
  12. 1110 nmioff =$fec1 ;restore is off here
  13. 1120 stuff  =$f000 ;mem. for snag stack
  14. 1130 string =$ab1e ;display a string
  15. 1140 getin  =$ffe4 ;get a keyboard byte
  16. 1150 chrout =$ffd2 ;output a byte
  17. 1160 chrin  =$ffcf ;64's input routine
  18. 1170 plot   =$fff0 ;plot 64's cursor
  19. 1180 close  =$ffc3 ;close a file
  20. 1190 clall  =$ffe7 ;close all files
  21. 1200 open   =$ffc0 ;open a file
  22. 1210 setnam =$ffbd ;set file name
  23. 1220 setlfs =$ffba ;set file status
  24. 1230 talk   =$ffb4 ;make device talk
  25. 1240 tksa   =$ff96 ;talk second address
  26. 1250 chkout =$ffc9 ;open output channel
  27. 1260 untlk  =$ffab ;make device untalk
  28. 1270 acptr  =$ffa5 ;serial port get
  29. 1280 cursco =$0286 ;64's cursor color
  30. 1290 scnlin =$0748 ;start of menu
  31. 1300 txtlin =$0770 ;start of text line
  32. 1310 collin =$db48 ;menu color memory
  33. 1320 a      =$02 ;temps used everywhere
  34. 1330 b      =$03 ;     ''      ''
  35. 1340 xtemp  =$04 ;     ''      ''
  36. 1350 ytemp  =$05 ;     ''      ''
  37. 1360 blockx =$fd ;position of block
  38. 1370 blocky =$fe ;     ''      ''
  39. 1380 xpos   =$fb ;position of cursor
  40. 1390 ypos   =$fc ;     ''      ''
  41. 1400 lowpnt =$06 ;low-high used in plot
  42. 1410 highpt =$07 ;     ''      ''
  43. 1420 collow =$22 ;used to get old color
  44. 1430 colhii =$23 ;     ''      ''
  45. 1440 oldcol =$24 ;flag- use old color
  46. 1450 addmov =$25 ;flag- right or down
  47. 1460 xptemp =$4b ;temp for make block
  48. 1470 yptemp =$4c ;     ''      ''
  49. 1480 xbtemp =$4d ;     ''      ''
  50. 1490 ybtemp =$4e ;     ''      ''
  51. 1500 flpplt =$4f ;flag- plot y,x *(x,y)
  52. 1510 output =$50 ;flag- output unblock
  53. 1520 lastch =$51 ;temp for unblock
  54. 1530 choice =$52 ;append choice (y/n)
  55. 1540 curcol =$53 ;current snag color
  56. 1550 qtmode =$d4 ;64 quote mode on/off
  57. 1560 ;
  58. 1570 ;the following code copies the
  59. 1580 ;stack and zero page so that snag
  60. 1590 ;has it's own stack and zero page
  61. 1600 ;when entered via the hardware irq
  62. 1610 ;
  63. 1620 intstr lda #"n"      ;start append
  64. 1630        sta choice    ;choice as 'n
  65. 1640        lda #"/"
  66. 1650        sta fname     ;start file
  67. 1660        lda #","      ;name as '/'
  68. 1670        sta fname+1
  69. 1680        sei
  70. 1690        lda #>rthere   ;set return
  71. 1700        pha            ;address for
  72. 1710        lda #<rthere-1 ;flip stack
  73. 1720        pha            ;routine.
  74. 1730        tsx            ;save stack
  75. 1740        stx stktmp     ;pointer
  76. 1750        lda #0
  77. 1760        sta $fb        ;copy first
  78. 1770        sta $fc        ;4 blocks of
  79. 1780        lda #<stuff    ;memory
  80. 1790        sta $fd
  81. 1800        lda #>stuff
  82. 1810        sta $fe
  83. 1820        ldx #4
  84. 1830        ldy #2
  85. 1840 mrtoit lda ($fb),y
  86. 1850        sta ($fd),y
  87. 1860        iny
  88. 1870        bne mrtoit
  89. 1880        inc $fc
  90. 1890        inc $fe
  91. 1900        dex
  92. 1910        bne mrtoit
  93. 1920        lda #<nmioff  ;snag vectors
  94. 1930        sta $0318     ;snag restore
  95. 1940        lda #>nmioff  ;is disabled
  96. 1950        sta $0319
  97. 1960        lda #<extsng  ;brk vector
  98. 1970        sta $0316     ;is used to
  99. 1980        lda #>extsng  ;exit snag
  100. 1990        sta $0317
  101. 2000        lda #>start  ;new pch
  102. 2010        pha
  103. 2020        lda #<start  ;new pcl
  104. 2030        pha
  105. 2040        lda #0       ;status
  106. 2050        pha
  107. 2060        pha          ;.a
  108. 2070        pha          ;.x
  109. 2080        pha          ;.y
  110. 2090        lda #>rthre2   ;set return
  111. 2100        pha            ;address for
  112. 2110        lda #<rthre2-1 ;next flip
  113. 2120        pha            ;stack call
  114. 2130        jmp flipmm   ;flip stacks
  115. 2140 rthere lda #<baserr ;change basics
  116. 2150        sta $0300    ;error message
  117. 2160        lda #>baserr ;vector to
  118. 2170        sta $0301    ;reset irq
  119. 2180        cli
  120. 2190        lda #96      ;put an rts
  121. 2200        sta intstr   ;in first byte
  122. 2210        rts
  123. 2220 ;
  124. 2230 ;every time basic prints an error
  125. 2240 ;or a 'ready' the irq vector is
  126. 2250 ;set to snag
  127. 2260 ;
  128. 2270 baserr sei
  129. 2280        ldy #<(NULL)ther ;new irq that
  130. 2290        sty $0314    ;looks for a
  131. 2300        ldy #>(NULL)ther ;ctrl-f3
  132. 2310        sty $0315
  133. 2320        cli
  134. 2330        jmp $e38b
  135. 2340 ;
  136. 2350 ;the irq comes here to look for
  137. 2360 ;a ctrl-f3
  138. 2370 ;
  139. 2380 (NULL)ther lda $c5      ;look for f3
  140. 2390        cmp #5
  141. 2400        beq yesf3
  142. 2410 outirq jmp $ea31
  143. 2420 yesf3  lda $028d    ;look for ctrl
  144. 2430        cmp #4
  145. 2440        bne outirq
  146. 2450        lda #>retext
  147. 2460        pha
  148. 2470        lda #<retext-1
  149. 2480        pha
  150. 2490        jmp flipmm   ;flip stacks
  151. 2500 rthre2 jmp $ea31
  152. 2510 ;
  153. 2520 extsng lda #>rthre2
  154. 2530        pha
  155. 2540        lda #<rthre2-1
  156. 2550        pha
  157. 2560        jmp flipmm   ;flip stacks
  158. 2570 retext jmp $ea31
  159. 2580 ;
  160. 2590 ;this routine flips the stack
  161. 2600 ;memory with a modified stack
  162. 2610 ;in memory without using
  163. 2620 ;zero page
  164. 2630 ;
  165. 2640 flipmm lda #<stuff
  166. 2650        sta top+1    ;source low
  167. 2660        sta stuff2+1
  168. 2670        lda #>stuff
  169. 2680        sta top+2    ;source high
  170. 2690        sta stuff2+2
  171. 2700        lda #0
  172. 2710        sta stuff1+1 ;target low
  173. 2720        sta stuff3+1
  174. 2730        sta stuff1+2 ;target high
  175. 2740        sta stuff3+2
  176. 2750        ldy #4
  177. 2760        ldx #2
  178. 2770 toplop lda #52      ;off basic
  179. 2780        sta $01
  180. 2790 top    lda $ffff,x  ;source
  181. 2800        sta tmpbyt
  182. 2810        lda #55      ;on basic
  183. 2820        sta $01
  184. 2830 stuff1 lda $ffff,x  ;target
  185. 2840 stuff2 sta $ffff,x  ;source
  186. 2850        lda tmpbyt
  187. 2860 stuff3 sta $ffff,x  ;target
  188. 2870        inx
  189. 2880        bne toplop
  190. 2890        inc top+2
  191. 2900        inc stuff1+2
  192. 2910        inc stuff2+2
  193. 2920        inc stuff3+2
  194. 2930        dey
  195. 2940        bne toplop
  196. 2950        lda stktmp   ;flip stack
  197. 2960        tsx          ;pointers
  198. 2970        stx stktmp
  199. 2980        tax
  200. 2990        txs
  201. 3000        rts
  202. 3010 ;
  203. 3020 start  ldy #0       ;actual start
  204. 3030        sty xpos     ;of snag code
  205. 3040        lda #216
  206. 3050        sta ypos
  207. 3060        lda #<color  ;make a copy
  208. 3070        sta blockx   ;of screen
  209. 3080        lda #>color  ;color
  210. 3090        sta blocky
  211. 3100        ldx #4
  212. 3110 trans  lda (xpos),y
  213. 3120        sta (blockx),y
  214. 3130        iny
  215. 3140        bne trans
  216. 3150        inc ypos
  217. 3160        inc blocky
  218. 3170        dex
  219. 3180        bne trans    ;set snag cur-
  220. 3190        lda 53281    ;sor color
  221. 3200        and #15      ;according to
  222. 3210        tax          ;table
  223. 3220        lda colors,x
  224. 3230        sta curcol
  225. 3240        ldx #255     ;disable block
  226. 3250        stx blockx   ;with two ff's
  227. 3260        stx blocky
  228. 3270        inx
  229. 3280        stx oldcol ;1 = old color
  230. 3290        stx addmov ;1 = add x or y
  231. 3300        stx flpplt ;1 = y,x not x,y
  232. 3310        stx output ;1 = disk/printr
  233. 3320        stx xpos   ;cursor x and y
  234. 3330        stx ypos
  235. 3340        txa
  236. 3350        tay        ;plot initial
  237. 3360        jsr revers ;cursor
  238. 3370 getmor jsr getin
  239. 3380        beq getmor
  240. 3390        cmp #"[133]"   ;is it an f1
  241. 3400        bne nostop
  242. 3410        jsr unblck ;yes, shut off
  243. 3420        ldx xpos   ;block, erase
  244. 3430        ldy ypos   ;cursor and exit
  245. 3440        inc oldcol ;according to
  246. 3450        jsr revers ;the brk vector
  247. 3460        brk
  248. 3470        nop:nop:nop ;pc returns
  249. 3480        jmp start   ;here
  250. 3490 nostop cmp #""    ;cursor right
  251. 3500        bne notrit
  252. 3510        ldx xpos
  253. 3520        cpx #39
  254. 3530        beq notrit
  255. 3540        inc addmov  ;set add flag
  256. 3550        jsr xblock  ;move right
  257. 3560        dec addmov  ;unset add flag
  258. 3570 notrit cmp #"[157]"    ;cursor left
  259. 3580        bne notlft
  260. 3590        ldx xpos
  261. 3600        beq notlft
  262. 3610        inc oldcol  ;set color flag
  263. 3620        jsr xblock  ;move left
  264. 3630        dec oldcol  ;unset col flag
  265. 3640 notlft cmp #""    ;cursor down
  266. 3650        bne notdwn
  267. 3660        ldx ypos
  268. 3670        cpx #24
  269. 3680        beq notdwn
  270. 3690        inc addmov  ;set add flag
  271. 3700        jsr yblock  ;move down
  272. 3710        dec addmov  ;unset add flag
  273. 3720 notdwn cmp #"[145]"    ;cursor up
  274. 3730        bne notup
  275. 3740        ldx ypos
  276. 3750        beq notup
  277. 3760        inc oldcol  ;set color flag
  278. 3770        jsr yblock  ;m